home *** CD-ROM | disk | FTP | other *** search
/ Power CD / Power CD ATARI-Rechner Lieben.iso / DEMOS / HM2_DEMO / BSP / DHRY.M < prev    next >
Encoding:
Text File  |  1992-12-10  |  9.3 KB  |  374 lines
  1. MODULE DhryStone;
  2.  
  3. (*
  4.  * Compilercode-Testprogramm.
  5.  *                                                                                             Version 1.2, 15. Mai 1990
  6.  *
  7.  * Portiert durch Dirk Steins von C-Source (Version 1.1) nach Modula-2,
  8.  * Ueberarbeitung und Dokumentation von Thomas Tempelmann.
  9.  *
  10.  * Register-Variable werden nicht im einzelnen spezifiziert, da dies
  11.  * bei Modula-2 nicht vorgesehen ist.
  12.  *
  13.  * Dafuer wird in 'Proc1' eine WITH-Anweisung verwendet, fuer die es in der
  14.  * C-Version nur ein Macro gibt (C bietet kein WITH-Konstrukt). Da aber
  15.  * alles darauf hinweist, dass im Original dieses Programms, das in ADA
  16.  * geschrieben wurde, WITH verwendet wurde, wird es auch hier in der
  17.  * Modula-Version getan, schon allein, weil es sinnvoll fuer den Test ist.
  18.  *
  19.  * Fuer den Test sollten alle globalen Optimierungen aktiviert sein
  20.  * und Bereichs-, Ueberlauf-, Stack- und weitere Pruefungen deaktiviert
  21.  * sein.
  22.  *
  23.  * Achtung: Um beim Megamax-System korrekte Ergebnisse zu erhalten,
  24.  * muss die Control-C-Abfrage in der Shell abgeschaltet sein!
  25.  *
  26.  * Ergebnisse:
  27.  *
  28.  * Compiler                         Hardware                                                 Dhrystones/s
  29.  *     SPC 2.0                        Atari ST 8MHz                                      493
  30.  *     Megamax 3.8                Atari ST 8MHz                                      522
  31.  *     FTL 1.18                     Atari ST 8MHz                                      656
  32.  *     Hänisch 3.105            Atari ST 8MHz                                      710
  33.  *     TDI 3.01                     Atari ST 8MHz                                      717
  34.  *     M2AMIGA 3.3                Amiga 2000 7.16MHz (2MB FastRAM) 847
  35.  *     FST 2.0                        IBM AT 286 12MHz                                 1060
  36.  *     Megamax 4.0                Atari ST 8MHz                                      1061
  37.  *     Rowley 1.34                Atari ST 8MHz                                      1500
  38.  *     LogiTech 3.4 DOS     80386 24MHz/0ws                                  4755
  39.  *     Rowley 1.34                Sun-3/60    68020 20 MHz                     5500
  40.  *     Rowley 1.33                T800    20 MHz                                         8500
  41.  *     Rowley 1.33                R3000  16 MHz                                      12500
  42.  *     ---------------------------------------------------------
  43.  *     Megamax 4.0             Atari ST 32MHz                                      2941
  44.  *
  45.  *     Hänisch 3.20a         Atari ST 8MHz    (K+)                             893
  46.  *     Hänisch 3.20a         Atari ST 8MHz    (RegVar,K+)              906
  47.  *
  48.  *     Hänisch 3.20a         Atari TT 32MHz  (K+)                          2538
  49.  *     Hänisch 3.20a         Atari TT 32MHz  (Reg-Var,K+)          2816
  50.  *     Hänisch 3.20a         Atari TT 32MHz  (20er,K-)                 2531
  51.  *     Hänisch 3.20a         Atari TT 32Mhz  (RegVar,20er,K-)  2828
  52.  *
  53.  *     TopSpeed 1.17         386SX        16MHz                                      3012
  54.  *     FTL                             386SX        16MHz                                      2336
  55.  *
  56.  *     Hänisch 5.10          Atari TT 32Mhz  (RegVar)                  5970
  57.  *     Hänisch 5.10          Atari TT 32Mhz  (RegVar,20er,K-)  6016
  58.  *     ---------------------------------------------------------
  59.  *     Ohne Compare-Aufruf:
  60.  *     Megamax 4.0             Atari ST 32MHz                                      3210
  61.  *
  62.  *     Hänisch 3.20a         Atari TT 32Mhz  (RegVar,20er,K-)  3322
  63.  *
  64.  *)
  65.  
  66. FROM SYSTEM         IMPORT ADR;
  67. FROM Storage        IMPORT ALLOCATE;
  68. FROM InOut            IMPORT WriteString, WriteLn, WriteCard, WriteInt, Read;
  69. FROM Str                IMPORT Compare;
  70.  
  71.     (*$W+*)
  72.  
  73. (**** Compiler-/Library-abhaengige Importe ****)
  74.  
  75.         (* fuer time-Funktion, s.u. *)
  76.         (*
  77.         FROM Minix            IMPORT time;
  78.         *)
  79.         FROM SysVar         IMPORT T200Hz;
  80.         FROM SYSTEM         IMPORT ADDRESS, CODE, TSIZE;
  81.  
  82. (**** Compiler-abhaengige Definitionen ****)
  83.  
  84.         TYPE    Integer      = SHORTINT;    (* moeglichst 16 Bit-Integer *)
  85.  
  86.  
  87. (**** Compiler-/Library-abhaengige Funktionen ****)
  88.  
  89.  
  90. (**** Beginn des unabhaengigen Programms *)
  91.  
  92.  
  93. CONST Version = "1.2";
  94.  
  95. CONST LOOPS = 50000;    (* fuer ca. 10 - 20 Sekunden *)
  96.  
  97.  
  98. TYPE Enumeration        = (Ident1, Ident2, Ident3, Ident4, Ident5);
  99. TYPE OneToThirty        = [1..30];
  100. TYPE OneToFifty         = [1..50];
  101. TYPE CapitalLetter    = CHAR;
  102. TYPE String30             = ARRAY [0..30] OF CHAR;
  103. TYPE Array1Dim            = ARRAY [0..50] OF Integer;
  104. TYPE Array2Dim            = ARRAY [0..50],[0..50] OF Integer;
  105.  
  106. TYPE RecordPtr            = POINTER TO RecordType;
  107.  
  108.          RecordType         = RECORD
  109.                                                 PtrComp     : RecordPtr;
  110.                                                 Discr         : Enumeration;
  111.                                                 EnumComp    : Enumeration;
  112.                                                 IntComp     : OneToFifty;
  113.                                                 StringComp: String30;
  114.                                             END;
  115.  
  116.  
  117. (*
  118.  * Package 1
  119.  *)
  120. VAR
  121.     IntGlob     : Integer;
  122.     BoolGlob    : BOOLEAN;
  123.     Char1Glob : CHAR;
  124.     Char2Glob : CHAR;
  125.     Array1Glob: Array1Dim;
  126.     Array2Glob: Array2Dim;
  127.     PtrGlb        : RecordPtr;
  128.     PtrGlbNext: RecordPtr;
  129.  
  130.  
  131. PROCEDURE Func1(CharPar1, CharPar2: CapitalLetter): Enumeration;
  132.     VAR (*$Reg*) CharLoc1,
  133.             (*$Reg*) CharLoc2 : CapitalLetter;
  134.     BEGIN
  135.         CharLoc1:= CharPar1;
  136.         CharLoc2:= CharLoc1;
  137.         IF (CharLoc2 # CharPar2) THEN
  138.             RETURN Ident1
  139.         ELSE
  140.             RETURN Ident2
  141.         END
  142.     END Func1;
  143.  
  144.  
  145. PROCEDURE Func2 ( VAR StrParI1, StrParI2: String30): BOOLEAN;
  146.     VAR (*$Reg*) IntLoc: OneToThirty;
  147.             (*$Reg*) CharLoc: CapitalLetter;
  148.     BEGIN
  149.         IntLoc:= 1;
  150.         WHILE (IntLoc <= 1) DO
  151.             IF (Func1 (StrParI1[IntLoc], StrParI2[IntLoc+1]) = Ident1) THEN
  152.                 CharLoc:= 'A';
  153.                 INC(IntLoc);
  154.             END;
  155.         END;
  156.         IF (CharLoc >= 'W') & (CharLoc <= 'Z') THEN
  157.             IntLoc:= 7;
  158.         END;
  159.         IF (CharLoc = 'X') THEN
  160.             RETURN TRUE
  161.         ELSE
  162.             IF (Compare(StrParI1, StrParI2) > 0) THEN
  163.                 INC(IntLoc,7);
  164.                 RETURN TRUE
  165.             ELSE
  166.                 RETURN FALSE
  167.             END
  168.         END;
  169.     END Func2;
  170.  
  171. PROCEDURE Func3(EnumParIn: Enumeration): BOOLEAN;
  172.     (*$Reg*) VAR    EnumLoc: Enumeration;
  173.     BEGIN
  174.         EnumLoc:= EnumParIn;
  175.         IF (EnumLoc = Ident3) THEN
  176.             RETURN TRUE
  177.         END;
  178.         RETURN FALSE
  179.     END Func3;
  180.  
  181.  
  182. PROCEDURE Proc7 ( IntParI1, IntParI2: OneToFifty; VAR IntParOut: OneToFifty);
  183.     (*$Reg*) VAR IntLoc: OneToFifty;
  184.     BEGIN
  185.         IntLoc:= IntParI1 + 2;
  186.         IntParOut:= IntParI2 + IntLoc;
  187.     END Proc7;
  188.  
  189. PROCEDURE Proc3(VAR PtrParOut : RecordPtr);
  190.     BEGIN
  191.         IF (PtrGlb # NIL) THEN
  192.             PtrParOut := PtrGlb^.PtrComp;
  193.         ELSE
  194.             IntGlob := 100;
  195.         END;
  196.         Proc7(10, IntGlob, PtrGlb^.IntComp);
  197.     END Proc3;
  198.  
  199. PROCEDURE Proc6(EnumParIn : Enumeration; VAR EnumParOut: Enumeration);
  200.     BEGIN
  201.         EnumParOut := EnumParIn;
  202.         IF (NOT Func3(EnumParIn) ) THEN
  203.             EnumParOut := Ident4;
  204.         END;
  205.         CASE EnumParIn OF
  206.             Ident1: EnumParOut := Ident1; |
  207.             Ident2: IF (IntGlob > 100) THEN
  208.                                 EnumParOut := Ident1
  209.                             ELSE
  210.                                 EnumParOut := Ident4
  211.                             END |
  212.             Ident3: EnumParOut := Ident2 |
  213.             Ident4: |
  214.             Ident5: EnumParOut := Ident3 |
  215.         END;
  216.     END Proc6;
  217.  
  218. PROCEDURE Proc1(PtrParIn : RecordPtr);
  219.     BEGIN
  220.         PtrParIn^.PtrComp^ := PtrGlb^;
  221.         PtrParIn^.IntComp := 5;
  222.         WITH PtrParIn^.PtrComp^ DO
  223.             IntComp := PtrParIn^.IntComp;
  224.             PtrComp := PtrParIn^.PtrComp;
  225.             Proc3(PtrComp);
  226.             IF (Discr = Ident1) THEN
  227.                 IntComp := 6;
  228.                 Proc6(PtrParIn^.EnumComp, EnumComp);
  229.                 PtrComp := PtrGlb^.PtrComp;
  230.                 Proc7(IntComp, 10, IntComp);
  231.             ELSE
  232.                 PtrParIn := PtrParIn^.PtrComp;
  233.             END;
  234.         END;
  235.     END Proc1;
  236.  
  237. PROCEDURE Proc2(VAR IntParIO : OneToFifty);
  238.     VAR (*$Reg*) IntLoc  : OneToFifty;
  239.             (*$Reg*) EnumLoc : Enumeration;
  240.     BEGIN
  241.         IntLoc := IntParIO + 10;
  242.         LOOP
  243.             IF (Char1Glob = 'A') THEN
  244.                 DEC(IntLoc);
  245.                 IntParIO := IntLoc - VAL (OneToFifty, IntGlob);
  246.                 EnumLoc  := Ident1;
  247.             END;
  248.             IF (EnumLoc = Ident1) THEN
  249.                 EXIT
  250.             END;
  251.         END;
  252.     END Proc2;
  253.  
  254. PROCEDURE Proc4();
  255.     VAR (*$Reg*) BoolLoc : BOOLEAN;
  256.     BEGIN
  257.         BoolLoc := Char1Glob = 'A';
  258.         BoolLoc := NOT BoolGlob;
  259.         Char2Glob := 'B';
  260.     END Proc4;
  261.  
  262. PROCEDURE Proc5();
  263.     BEGIN
  264.         Char1Glob := 'A';
  265.         BoolGlob := FALSE;
  266.     END Proc5;
  267.  
  268. PROCEDURE Proc8 ( VAR Array1Par: Array1Dim; VAR Array2Par: Array2Dim;
  269.                                     IntParI1, IntParI2: OneToFifty);
  270.     VAR (*$Reg*) IntLoc: OneToFifty;
  271.             (*$Reg*) IntIndex: OneToFifty;
  272.     BEGIN
  273.         IntLoc:= IntParI1 + 5;
  274.         Array1Par[IntLoc]:= IntParI2;
  275.         Array1Par[IntLoc+1]:= Array1Par[IntLoc];
  276.         Array1Par[IntLoc+30]:= IntLoc;
  277.         FOR IntIndex:= IntLoc TO IntLoc+1 DO
  278.             Array2Par[IntLoc][IntIndex]:= IntLoc;
  279.         END;
  280.         INC(Array2Par[IntLoc][IntLoc-1]);
  281.         Array2Par[IntLoc+20][IntLoc]:= Array1Par[IntLoc];
  282.         IntGlob:= 5;
  283.     END Proc8;
  284.  
  285. PROCEDURE Proc0();
  286.     VAR
  287.         IntLoc1      : OneToFifty;
  288.         (*$Reg*) IntLoc2        : OneToFifty;
  289.         IntLoc3      : OneToFifty;
  290.         (*$Reg*) CharLoc        : CHAR;
  291.         (*$Reg*) CharIndex    : CHAR;
  292.         EnumLoc      : Enumeration;
  293.         String1Loc : String30;
  294.         String2Loc : String30;
  295.         starttime  : LONGINT;
  296.         benchtime  : LONGINT;
  297.         nulltime     : LONGINT;
  298.         i                  : [0..LOOPS];
  299.  
  300.     BEGIN
  301.         starttime := T200Hz();
  302.         FOR i := 0 TO LOOPS-1 DO END;
  303.         nulltime := INT(T200Hz()) - starttime; (* Computes overhead of loop *)
  304.  
  305.         ALLOCATE (PtrGlbNext, TSIZE (RecordPtr));
  306.         ALLOCATE (PtrGlb, TSIZE (RecordPtr));
  307.         PtrGlb^.PtrComp := PtrGlbNext;
  308.         PtrGlb^.Discr := Ident1;
  309.         PtrGlb^.EnumComp := Ident3;
  310.         PtrGlb^.IntComp := 40;
  311.         PtrGlb^.StringComp := "DHRYSTONE PROGRAM, SOME STRING";
  312.         String1Loc := "DHRYSTONE PROGRAM, 1'ST STRING";     (*GOOF*)
  313.         Array2Glob[8][7] := 10;
  314.  
  315.         (*****************
  316.         -- Start Timer --
  317.         *****************)
  318.  
  319.         starttime := INT(T200Hz());
  320.  
  321.         FOR i := 0 TO LOOPS-1 DO
  322.             Proc5();
  323.             Proc4();
  324.             IntLoc1 := 2;
  325.             IntLoc2 := 3;
  326.             String2Loc := "DHRYSTONE PROGRAM, 2'ND STRING";
  327.             EnumLoc := Ident2;
  328.             BoolGlob := NOT Func2(String1Loc, String2Loc);
  329.             WHILE (IntLoc1 < IntLoc2)  DO
  330.                 IntLoc3 := 5 * IntLoc1 - IntLoc2;
  331.                 Proc7(IntLoc1, IntLoc2, IntLoc3);
  332.                 INC(IntLoc1);
  333.             END;
  334.             Proc8(Array1Glob, Array2Glob, IntLoc1, IntLoc3);
  335.             Proc1(PtrGlb);
  336.             FOR CharIndex := 'A' TO Char2Glob DO
  337.                 IF (EnumLoc = Func1(CharIndex, 'C')) THEN
  338.                     Proc6(Ident1, EnumLoc);
  339.                 END;
  340.             END;
  341.             IntLoc3 := IntLoc2 * IntLoc1;
  342.             IntLoc2 := IntLoc3 DIV IntLoc1;
  343.             IntLoc2 := 7 * (IntLoc3 - IntLoc2) - IntLoc1;
  344.             Proc2(IntLoc1);
  345.         END;
  346.  
  347.  
  348.         (*****************
  349.         -- Stop Timer --
  350.         *****************)
  351.  
  352.         benchtime := INT(T200Hz()) - starttime - nulltime;
  353.         WriteString("Modula-2 Dhrystone (");
  354.         WriteString(Version);
  355.         WriteString(") time for ");
  356.         WriteCard(LOOPS,6);
  357.         WriteString(" passes is ");
  358.         WriteInt(benchtime DIV 200, 5);
  359.         WriteLn;
  360.         WriteString("This machine benchmarks at ");
  361.         WriteInt(LOOPS*200 DIV benchtime,6);
  362.         WriteString(" dhrystones/second");
  363.         WriteLn;
  364.     END Proc0;
  365.  
  366. VAR ch: CHAR;
  367.  
  368. BEGIN
  369.     WriteString ("Running...");
  370.     WriteLn;
  371.     Proc0 ();
  372.     Read (ch);
  373. END DhryStone.
  374.         
  375.     
  376.